COMMENT ⊗   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	(* $A+,D+*)
C00006 ENDMK
C⊗;
(* $A+,D+*)
program	PALINDROME(OUTPUT);

const    PALMAX = 1000; PALLIM = 1001;
var I, J, N, PALVAL, CARRY : integer;
    PAL,PAL2 : array [1..PALLIM] of integer;

begin
writeln (OUTPUT,'Test of 196, mirror added to'PALMAX:5,' digits');
writeln (TTY,'Test of 196, mirror added to'PALMAX:5,' digits'); BREAK;
for I := 1 TO PALMAX do PAL[I] := 0;
PAL [1] := 6; PAL [2] := 9; PAL[3] := 1; PALVAL := 3; 	(* Initial conditions*)
N := 0;
while PALVAL <= PALMAX do
    begin (* while PALVAL <= PALMAX*)
    I := 1; J := PALVAL;
    if (N MOD 10) = 0 THEN write(TTY,N:5);
    if (N MOD 100) = 0 THEN writeln(TTY);
    while ((PAL[I] = PAL [J]) and (I < J)) do
	begin
	I := I + 1;  J := J - 1;
	end;
    if I < J then       (* Not a palindrome*)
	begin
	J := PALVAL; CARRY := 0;
	for I := 1 to PALVAL do
	    begin
	    PAL2[I] := PAL[I] + PAL[J] + CARRY;
	    if PAL2[I] > 9 then
		begin
		PAL2[I] := PAL2[I] - 10;  CARRY := 1;
		end
	    else CARRY := 0;
	    J := J - 1;
	    end;
	if CARRY = 1 then
	    begin
	    PALVAL := PALVAL +1;
	    PAL2[PALVAL] := 1;
	    CARRY := 0;
	    end;
	if PALVAL = PALMAX + 1 then
	    begin
	    writeln(OUTPUT);
	    write (OUTPUT,'Not a palindrome to',PALMAX:5,' DIGITS WITH',
		    N:5,' ADDITIONS');
	    writeln(TTY);
	    write (TTY,'Not a palindrome to',PALMAX:5,' DIGITS WITH',
		    N:5,' ADDITIONS'); BREAK;
	    end
	else
	    begin
	    for I := 1 to PALVAL do PAL[I] := PAL2[I];
	    N := N +1;
	    end;
	end             (* Not a palindrome*)
    else
	begin           (* A palindrome has been found*)
	writeln(OUTPUT);
	writeln (OUTPUT,' A PALINDROME FOUND WITH',PALVAL:6,' DIGITS AFTER',
	    N:4,' ADDITIONS');
	writeln(TTY);
	writeln (TTY,' A PALINDROME FOUND WITH',PALVAL:6,' DIGITS AFTER',
	    N:4,' ADDITIONS'); BREAK;
	PALVAL := PALMAX +1;   (* To effect exit from while PALVAL < PALMAX*)
	end (* a palindrome has been found*);
    end (* while PALVAL <= PALMAX*);
end.